home *** CD-ROM | disk | FTP | other *** search
/ Die Ultimative Software-P…i Collection 1996 & 1997 / Die Ultimative Software-Pakete CD-ROM fur Atari Collection 1996 & 1997.iso / l / lehrer / diktat / diktat.lst < prev    next >
Encoding:
File List  |  1996-11-17  |  10.4 KB  |  466 lines
  1. ' +++++++++++Diktat /18 +++++GfA+++++++++++5.90++++++
  2. ' +++++ G.Graßfeldt-Weingärtner ++++++++++++++
  3. DIM wort$(500),file$(12)
  4. gra%=1
  5. begi%=1
  6. GOSUB men
  7. DO
  8.   GOSUB auswahl
  9. LOOP
  10. ' +++++++++++++++++++++++++++++++
  11. PROCEDURE richtig
  12.   ri%=ri%+1
  13.   DEFTEXT 1,16,0,32
  14.   TEXT 135,365,"  !! GUT  GEMACHT !!  "
  15.   PAUSE 50
  16.   GRAPHMODE 1
  17.   y=0
  18.   DO
  19.     x=0
  20.     WHILE x<640
  21.       PBOX x,y,x+40,y+70
  22.       x=x+15
  23.     WEND
  24.     EXIT IF LEN(INKEY$) OR y>380
  25.     y=y+71
  26.   LOOP
  27.   DEFFILL 1,2,2
  28.   COLOR 0
  29.   far%=6
  30.   ' #############
  31.   IF gra%=1
  32.     FOR ra%=20 TO 150 STEP 20
  33.       DEFFILL 1,2,far%
  34.       PCIRCLE 320,195,ra%
  35.       PCIRCLE 150,205,ra%-10
  36.       PCIRCLE 490,205,ra%-10
  37.       INC far%
  38.     NEXT ra%
  39.   ENDIF
  40.   ' #############
  41.   IF gra%=2
  42.     FOR ra%=30 TO 90 STEP 10
  43.       DEFFILL 1,2,far%
  44.       PCIRCLE 190,150,ra%
  45.       PCIRCLE 260,260,ra%
  46.       PCIRCLE 380,260,ra%
  47.       PCIRCLE 450,150,ra%
  48.       PCIRCLE 320,90,ra%
  49.       INC far%
  50.     NEXT ra%
  51.   ENDIF
  52.   INC gra%
  53.   IF gra%=3
  54.     gra%=1
  55.   ENDIF
  56.   ' ##############
  57.   DEFFILL 0,1,0
  58.   PBOX 40,120,600,240
  59.   PBOX 60,140,580,220
  60.   TEXT 320-(LEN(wort$(wo%))*9),200,wort$(wo%)   !Zentrieren
  61.   COLOR 1
  62.   BOX 62,142,578,218
  63.   PRINT AT(32,10);"! Lese das Wort !"
  64.   DEFFILL 1,1,0
  65.   BOX 42,122,598,238
  66.   DEFFILL 1,2,4
  67.   FILL 300,130
  68. RETURN
  69. ' +++++++++++++++++++++++++++++++
  70. PROCEDURE falsch
  71.   fa%=fa%+1
  72.   anz$="Leider falsch"
  73.   PBOX 195,353,435,385
  74.   TEXT 200,380,anz$
  75.   FOR li%=1 TO 40
  76.     SOUND 1,15,li%,2
  77.     GRAPHMODE 3
  78.     y%=352
  79.     WHILE y%<388
  80.       LINE 195,y%,435,y%
  81.       INC y%
  82.       FOR i%=1 TO 60
  83.       NEXT i%
  84.     WEND
  85.   NEXT li%
  86.   SOUND 1,0,0,0
  87.   GRAPHMODE 1
  88.   lf%=l%*17
  89.   lf%=360-lf%
  90.   FOR xt%=100 TO lf% STEP 2
  91.     TEXT xt%,180,wort$(wo%)
  92.   NEXT xt%
  93. RETURN
  94. ' +++++++++Taste+++++++++++++++++
  95. PROCEDURE taste
  96.   DEFFILL 0,1,0
  97.   PBOX 175,350,455,395
  98.   BOX 182,360,448,390
  99.   PRINT AT(26,24);" Weiter --> beliebige Taste !"
  100.   PRINT AT(1,1);
  101.   t=INP(2)
  102. RETURN
  103. ' +++++Anzeige+++++++++++++++++++
  104. PROCEDURE anzeige
  105.   DEFTEXT 1,0,0,20
  106.   ri$="Richtig -->"
  107.   fal$="Falsch -->"
  108.   TEXT 100,260,ri$
  109.   TEXT 240,260,ri%
  110.   TEXT 360,260,fal$
  111.   TEXT 490,260,fa%
  112. RETURN
  113. ' +++++++++++Menutitel+++++++++++++
  114. PROCEDURE men
  115.   BLOAD "DTITEL.DOO",XBIOS(2)
  116.   SGET titel$
  117.   IF begi%=1
  118.     ALERT 2,"Anleitung|erwünscht",2,"ja|nein",anl%
  119.     IF anl%=1
  120.       GOSUB anleit
  121.     ENDIF
  122.     begi%=0
  123.   ENDIF
  124. RETURN
  125. ' ++++++++++++++++++++++++++++++++++
  126. PROCEDURE auswahl
  127.   back:
  128.   SPUT titel$
  129.   DO
  130.     MOUSE x,y,k
  131.     '
  132.     d%=INT(x/310)  ! 320 ist Feldbreite
  133.     e%=INT(y/70)   !  70 ist Feldhöhe (Pixel)
  134.     f%=2*e%+d%       ! F=Feldnummer
  135.     EXIT IF k=1 AND x>26 AND x<613 AND y>66 AND y<348   ! linke Maustaste
  136.   LOOP
  137.   IF f%=2 OR f%=4 OR f%=6 OR f%=8 THEN
  138.     x=32
  139.   ELSE
  140.     x=608
  141.   ENDIF
  142.   DEFFILL 1,2,2
  143.   FILL x,y
  144.   PAUSE 60
  145.   IF f%<8
  146.     GOSUB wieder       !Wortwiederholung ein-aus
  147.   ENDIF
  148.   IF f%=9
  149.     ALERT 2,"Wirklich aufhören",2,"Ende|Nein",en%
  150.     IF en%=1 THEN
  151.       END
  152.     ELSE
  153.       GOTO back
  154.     ENDIF
  155.   ENDIF
  156.   IF f%>1
  157.     IF f%<8
  158.       GOSUB schreiben
  159.     ENDIF
  160.   ENDIF
  161.   IF f%=8
  162.     GOSUB wortdat
  163.   ENDIF
  164. RETURN
  165. ' +++++++++++++++++++++++++++++++++
  166. PROCEDURE schreiben
  167.   GRAPHMODE 1
  168.   ri%=0
  169.   fa%=0
  170.   CLS
  171.   DEFLINE 1,1
  172.   DEFTEXT 1,16,0,26
  173.   muster=4
  174.   wo%=1
  175.   IF wort$(wo%)=""
  176.     GOSUB fehl
  177.   ENDIF
  178.   DO
  179.     EXIT IF RIGHT$(wort$(wo%),1)="#" OR wort$(wo%)=" " OR wort$(wo%)=""
  180.     CLS
  181.     TEXT 200,100,260,"DIKTAT"
  182.     BOX 2,200,60,230
  183.     BOX 4,203,62,227
  184.     BOX 6,205,64,225
  185.     PRINT AT(3,14);wo%
  186.     BOX 400,200,580,230
  187.     BOX 402,203,582,227
  188.     BOX 404,205,584,225
  189.     PRINT AT(56,14);"Ri:";ri%;"   Fa:";fa%
  190.     BOX 50,120,600,200
  191.     BOX 47,117,603,203
  192.     BOX 50,230,600,310
  193.     BOX 47,227,603,313
  194.     IF wd%=1
  195.       PRINT AT(28,23);" Wiederholung +    Ende #"
  196.     ELSE
  197.       PRINT AT(28,23);"Wiederholung aus!!  Ende #"
  198.     ENDIF
  199.     RBOX 195,350,435,370
  200.     DEFFILL 1,2,muster
  201.     FILL 1,1
  202.     FILL 300,205
  203.     ' ++++++++++
  204.     l%=LEN(wort$(wo%))
  205.     le%=l%/2
  206.     teil%=l%-le%
  207.     zuf%=RANDOM(l%)+1
  208.     ' ++++++++++++++
  209.     c$=""
  210.     IF f%=2
  211.       c$=""
  212.     ENDIF
  213.     IF f%=5
  214.       c$=LEFT$(wort$(wo%),le%)
  215.       c$=c$+STRING$(teil%,"_")
  216.     ENDIF
  217.     IF f%=4
  218.       c$=wort$(wo%)
  219.       MID$(c$,zuf%)="_"
  220.     ENDIF
  221.     IF f%=3
  222.       c$=RIGHT$(wort$(wo%),le%)
  223.       c$=STRING$(teil%,"_")+c$
  224.     ENDIF
  225.     IF f%=6
  226.       c$=wort$(wo%)
  227.       MID$(c$,zuf%)="__"
  228.     ENDIF
  229.     ' +++++++++++++
  230.     wieder:
  231.     TEXT 100,180,wort$(wo%)
  232.     IF f%=2
  233.       pau%=1
  234.     ELSE
  235.       pau%=100
  236.     ENDIF
  237.     PAUSE pau%
  238.     TEXT 100,180,c$
  239.     ' +++++++++++++
  240.     IF f%=7
  241.       GOSUB verdeck
  242.     ENDIF
  243.     ' ++++++++++++
  244.     PRINT CHR$(7)
  245.     TEXT 80,280,"                       "
  246.     TEXT 73,282,"⇨"
  247.     txt$=""
  248.     DO
  249.       DO
  250.         bu$=INKEY$
  251.         EXIT IF bu$<>" "   !bei Eingabefehler
  252.       LOOP
  253.       EXIT IF bu$=CHR$(13) OR LEN(txt$)>27 ! Return oder Wort zu lang
  254.       TEXT 100,280,txt$
  255.       IF bu$=CHR$(8) AND LEN(txt$)>0   ! Backspace testen
  256.         txt$=LEFT$(txt$,LEN(txt$)-1)
  257.         frei$="                           "
  258.         TEXT 100,280,frei$
  259.         TEXT 100,280,txt$
  260.       ELSE
  261.         IF bu$<>CHR$(8) THEN
  262.           txt$=txt$+bu$
  263.         ENDIF
  264.       ENDIF
  265.     LOOP
  266.     IF wd%=1
  267.       IF RIGHT$(txt$,1)="+"
  268.         PRINT AT(1,1)
  269.         GOTO wieder
  270.       ENDIF
  271.     ENDIF
  272.     '
  273.     EXIT IF RIGHT$(txt$,1)="#"
  274.     IF txt$=wort$(wo%)
  275.       GOSUB richtig
  276.       GRAPHMODE 1
  277.     ELSE
  278.       GOSUB falsch
  279.     ENDIF
  280.     bu$=""
  281.     txt$=""
  282.     muster=muster+1
  283.     IF muster=23
  284.       muster=2
  285.     ENDIF
  286.     GOSUB taste
  287.     INC wo%
  288.   LOOP
  289.   ' +++++Ende++++++++++
  290.   CLS
  291.   BOX 55,195,585,280
  292.   BOX 52,192,588,283
  293.   BOX 50,190,590,285
  294.   BOX 30,80,610,340
  295.   TEXT 120,180,400,"E N D E"
  296.   DEFFILL 1,2,7
  297.   FILL 130,170
  298.   GOSUB anzeige
  299.   GOSUB taste
  300. RETURN
  301. ' +++++++++++++++++++++++++
  302. PROCEDURE speichern
  303.   CLS
  304.   PRINT "        N e u e    Diktatwörter  eingeben    ( Wort + Return)."
  305.   PRINT "        Beenden:   -#-   eingeben    und  Return   drücken   !"
  306.   PRINT "        Dateiname    max. 8+3 Buchstaben    zB.:  AUTOBAHN.DAT"
  307.   PRINT "        Wortkorrektur: Statt neuem Wort  -  (minus) und Return "
  308.   PRINT "        eingeben und das Wort nochmals   richtig  schreiben  !"
  309.   PRINT "        Neue Wörter an eine <bestehende> Datei anhängen:In der"
  310.   PRINT "        Fileselectbox den Dateinamen auswählen und dann danach"
  311.   PRINT "               in der Alertbox   <erweit.>   anklicken.  "
  312.   PRINT "               Maximal  500   Wörter pro Datei möglich."
  313.   PRINT
  314.   wo%=1
  315.   alt$=wort$(1)
  316.   DO
  317.     PRINT wo%;")";
  318.     FORM INPUT 28,wort$(wo%)
  319.     GOSUB leer
  320.     '
  321.     IF RIGHT$(wort$(wo%),1)="-"      ! Wortkorrektur
  322.       wo%=wo%-2
  323.     ENDIF
  324.     IF wo%<1
  325.       wo%=0
  326.     ENDIF
  327.     EXIT IF RIGHT$(wort$(wo%),1)="#" OR wo%=500
  328.     INC wo%
  329.   LOOP
  330.   ' +++++++++
  331.   IF RIGHT$(wort$(1),1)="#"
  332.     wort$(1)=alt$
  333.     GOTO weiter
  334.   ENDIF
  335.   ' ++++  Datei schreiben ++++++++++++++++
  336.   nochmal:
  337.   CLOSE #1
  338.   GOSUB laufw
  339.   FILESELECT laufwerk$," ",file$
  340.   IF file$=""                        ! bei Abbruch
  341.     GOTO weiter
  342.   ENDIF
  343.   wo%=1
  344.   ant%=0
  345.   IF EXIST(file$)
  346.     ALERT 3,"Dateiname bereits vorhanden|Datei erweitern ?|Datei überschreiben ?",1,"erweit.|schreibe|Abbruch",ant%
  347.   ENDIF
  348.   IF ant%=1
  349.     OPEN "A",#1,file$
  350.   ENDIF
  351.   IF ant%=2 OR ant%=0
  352.     OPEN "O",#1,file$
  353.   ENDIF
  354.   IF ant%=3
  355.     GOTO nochmal
  356.   ENDIF
  357.   DO
  358.     EXIT IF RIGHT$(wort$(wo%),1)="#"
  359.     PRINT #1;wort$(wo%)
  360.     INC wo%
  361.   LOOP
  362.   CLOSE #1
  363.   weiter:
  364. RETURN
  365. ' +++++++++++++++++++++++++++
  366. PROCEDURE verdeck
  367.   PBOX 60,140,590,170
  368. RETURN
  369. ' +++++++++++++++++++++++++++
  370. PROCEDURE einlesen
  371.   GOSUB laufw
  372.   CLS
  373.   PRINT "               Welche Datei (xxxxxxxx.DAT) soll geübt werden ?"
  374.   PRINT "    -----------------------------------------------------------------------"
  375.   GOSUB loesch
  376.   FILESELECT laufwerk$," ",file$
  377.   wo%=1
  378.   IF EXIST(file$)
  379.     OPEN "I",#1,file$
  380.     DO
  381.       EXIT IF EOF(#1) OR wo%=501
  382.       INPUT #1;wort$(wo%)
  383.       PRINT wort$(wo%);"  ";
  384.       IF LEN(wort$(wo%))<=1
  385.         IF wo%>=1
  386.           DEC wo%
  387.         ENDIF
  388.       ENDIF
  389.       GOSUB leer    ! Leerstellen abfragen
  390.       INC wo%
  391.     LOOP
  392.     CLOSE #1
  393.   ELSE
  394.     GOSUB fehl
  395.   ENDIF
  396.   GOSUB taste
  397. RETURN
  398. ' +++++++++++
  399. PROCEDURE fehl
  400.   te$="Keine Wortdatei gefunden !|Bitte erst einlesen|oder neu erstellen !"
  401.   kn$="Weiter"
  402.   ALERT 1,te$,1,kn$,knopf%
  403. RETURN
  404. ' ++++++++++++
  405. PROCEDURE anleit
  406.   CLS
  407.   PRINT AT(8,7);"                 --------- Anleitung ---------"
  408.   PRINT "          Mit der  Maus  werden die einzelnen  Übungsarten ausgewählt."
  409.   PRINT "          Bei der Worteingabe  können notwendige  Korrekturen  mit der"
  410.   PRINT "          Backspace-Taste erfolgen !! Eingaben  mit der   Return-Taste"
  411.   PRINT "          abschließen.  Wortwiederholung  -->  + und  RETURN eingeben."
  412.   PRINT "          Vorzeitiges  Beenden  der Übung -->  # und  RETURN  drücken."
  413.   PRINT "          Alle erstellten Wortdateien müssen  die Endung ...DAT haben"
  414.   PRINT "                              (zB.:Besuch.DAT)."
  415.   PRINT "                        _____________________________"
  416.   PRINT "          Wichtig !! Vor den Übungen  zuerst eine  Wortdatei  einlesen"
  417.   PRINT "                     oder eine Wortdatei neu erstellen !"
  418.   BOX 30,60,610,320
  419.   BOX 50,80,590,300
  420.   FILL 300,61
  421.   GOSUB taste
  422.   SPUT titel$
  423. RETURN
  424. ' +++++++++++++++++++++++++++++
  425. PROCEDURE wortdat
  426.   ALERT 2,"Diktatwörter laden|oder neu schreiben ?",1," laden |  neu  ",zahl%
  427.   IF zahl%=2
  428.     GOSUB speichern
  429.   ELSE
  430.     GOSUB einlesen
  431.   ENDIF
  432. RETURN
  433. ' ++++++++++++++++++++++++++++++
  434. PROCEDURE laufw
  435.   ALERT 2,"                      | Welches Laufwerk | benutzen ? | ",1,"  A  |  B  |  C  ",lauf%
  436.   IF lauf%=1
  437.     laufwerk$="A:\*.Dat"
  438.   ENDIF
  439.   IF lauf%=2
  440.     laufwerk$="B:\*.Dat"
  441.   ENDIF
  442.   IF lauf%=3
  443.     laufwerk$="C:\*.dat"
  444.   ENDIF
  445. RETURN
  446. ' +++++++++++++++++++++++++++++++
  447. PROCEDURE loesch         !Alte Wörter löschen
  448.   FOR wo%=1 TO 500
  449.     wort$(wo%)=""
  450.   NEXT wo%
  451. RETURN
  452. ' ++++++++++++++++++++++++++++++++
  453. PROCEDURE wieder
  454.   ALERT 2,"Wortwiederholung",1,"ein|aus",wd%
  455. RETURN
  456. ' +++++++++++++++++++++++++++++++++
  457. PROCEDURE leer
  458.   WHILE RIGHT$(wort$(wo%))=" "
  459.     wort$(wo%)=LEFT$(wort$(wo%),LEN(wort$(wo%))-1)
  460.   WEND
  461.   WHILE LEFT$(wort$(wo%))=" "
  462.     wort$(wo%)=RIGHT$(wort$(wo%),LEN(wort$(wo%))-1)
  463.   WEND
  464. RETURN
  465. ' +++++++++++++++++++++++++++++++++++
  466.